home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / TOOLS / PC_DEMO.ZIP / PIC_BLD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-15  |  5.1 KB  |  160 lines
  1. PROGRAM Pic_Bld;
  2. { CONVERTS PC-DEMO PICTURES TO BASIC BLOAD FORMAT }
  3.  
  4.   CONST
  5.     Columns40           = 40;       { COLUMNS FROM 1 TO 40 }
  6.     Columns80           = 80;       { COLUMNS FROM 1 TO 80 }
  7.     LastLine            = 25;       { LINES FROM 1 TO 25 }
  8.     MaxtString          = 76;       { MAX CHARS IN FILE NAME W/ PATH AND EXT }
  9.     FourKB              = 4000;     { FILE SIZE OF 80-COLUMN PICTURE }
  10.     TwoKB               = 2000;     { FILE SIZE OF 40-COLUMN PICTURE }
  11.     Page40              = 2048;     { OFFSET FOR MULTIPLE PAGES IN 40-COL }
  12.     Page80              = 4096;     { OFFSET FOR MULTIPLE PAGES IN 80-COL }
  13.     BloadCode           = 253;      { FIRST BYTE OF A .BLD FILE }
  14.     EndOfFile           = 026;      { ASCII CODE FOR END OF FILE IN .BLD FILE }
  15.     BloadExt            = '.BLD';   { FILE EXTENSION FOR BLOAD FILES }
  16.     PictureExt          = '.PIC';   { FILE EXTENSION FOR FULL PICTURES }
  17.     Null                = '';       { NULL STRING }
  18.  
  19.   TYPE
  20.     N_PictureType       = ARRAY [1..LastLine, 1..Columns40] OF Integer;
  21.                                     { ARRAY OF 40-COLUMN PICTURE DATA }
  22.     W_PictureType       = ARRAY [1..LastLine, 1..Columns80] OF Integer;
  23.                                     { ARRAY OF 80-COLUMN PICTURE DATA }
  24.  
  25.     N_BloadType         = ARRAY [1..Page40] OF Byte;
  26.                                     { ARRAY OF 40-COLUMN BLOAD FILE DATA }
  27.     W_BloadType         = ARRAY [1..Page80] OF Byte;
  28.                                     { ARRAY OF 80-COLUMN BLOAD FILE DATA }
  29.  
  30.     ParString           = String [255];
  31.                                     { VARIABLE LENGTH STRING PARAMETER TYPE }
  32.  
  33.   VAR
  34.     I                   : Byte;
  35.  
  36.     Size                : Integer;
  37.  
  38.     IName,
  39.     OName               : ParString;
  40.  
  41.     W_Picture          : W_PictureType;
  42.                                     { THE 80-COLUMN PICTURE }
  43.  
  44.     N_Picture          : N_PictureType Absolute W_Picture;
  45.                                     { THE 40-COLUMN PICTURE }
  46.  
  47.     W_OutData           : W_BloadType;
  48.     N_OutData           : N_BloadType Absolute W_OutData;
  49.  
  50.     N_InFile            : FILE OF N_PictureType;
  51.     W_InFile            : FILE OF W_PictureType;
  52.  
  53.     N_OutFile           : FILE OF N_BloadType;
  54.     W_OutFile           : FILE OF W_BloadType;
  55.  
  56.     TestFile            : FILE OF Byte;
  57.  
  58.     N_InPtr             : ^ N_PictureType;
  59.     W_InPtr             : ^ W_PictureType;
  60.  
  61.  
  62.   FUNCTION Exist (FileName : ParString) : Boolean;
  63.   { SEES IF A FILE EXISTS }
  64.  
  65.     VAR
  66.       TestFile  : FILE;
  67.  
  68.     BEGIN    { Exist }
  69.       Assign (TestFile, FileName);
  70.  
  71. {$I-}
  72.  
  73.       Reset (TestFile);
  74.  
  75. {$I+}
  76.  
  77.       Exist := (IOResult = 0);
  78.       Close (TestFile);
  79.     END;     { Exist }
  80.  
  81.  
  82.  
  83.   PROCEDURE ConvertCase (VAR Strng : ParString);
  84.   { CONVERTS STRINGS TO UPPER CASE }
  85.  
  86.     VAR
  87.       I : Byte;
  88.  
  89.     BEGIN    { ConvertCase }
  90.       FOR I := 1 TO Length (Strng) DO
  91.         Strng [I] := UpCase (Strng [I]);
  92.     END;     { ConvertCase }
  93.  
  94.  
  95.   BEGIN    { Pic_Bld }
  96.     IName := Null;
  97.     IF ParamCount = 0
  98.       THEN
  99.         BEGIN
  100.           Writeln ('Command must be of form: PIC_BLD <name>');
  101.           Exit;
  102.         END;
  103.     IName := ParamStr (1);
  104.     Convertcase (IName);
  105.     OName := IName + BloadExt;
  106.     IName := IName + PictureExt;
  107.     IF NOT Exist (IName)
  108.       THEN
  109.        BEGIN
  110.          Writeln ('ERROR! File not found ' + IName);
  111.          Exit;
  112.        END;
  113.     Assign (TestFile, IName);
  114.     Reset (TestFile);
  115.     Size := FileSize (TestFile);
  116.     Close (TestFile);
  117.     IF NOT ((Size = TwoKB) OR (Size = FourKB))
  118.       THEN
  119.         BEGIN
  120.           Writeln ('ERROR! File wrong size.');
  121.           Exit;
  122.         END;
  123.     IF Size = TwoKB
  124.       THEN
  125.         BEGIN
  126.           N_OutData [1] := BloadCode;       { BLOAD FILE IDENTIFIER }
  127.           N_OutData [6] := Size MOD $100;   { FILE SIZE }
  128.           N_OutData [7] := Size DIV $100;   { FILE SIZE }
  129.           Assign (N_InFile, IName);
  130.           Reset (N_InFile);
  131.           Read (N_InFile, N_Picture);
  132.           N_InPtr := Ptr (Seg (N_OutData), Ofs (N_OutData) + 7);
  133.           N_InPtr ^ := N_Picture;           { TRANSFER PICTURE DATA }
  134.           N_OutData [2008] := EndOfFile;    { MARK END OF FILE }
  135.           Assign (N_OutFile, OName);
  136.           Rewrite (N_OutFile);
  137.           Write (N_OutFile, N_OutData);
  138.           Close (N_InFile);
  139.           Close (N_OutFile);
  140.         END
  141.       ELSE
  142.         BEGIN
  143.           W_OutData [1] := BloadCode;       { BLOAD FILE IDENTIFIER }
  144.           W_OutData [6] := Size MOD $100;   { FILE SIZE }
  145.           W_OutData [7] := Size DIV $100;   { FILE SIZE }
  146.           Assign (W_InFile, IName);
  147.           Reset (W_InFile);
  148.           Read (W_InFile, W_Picture);
  149.           W_InPtr := Ptr (Seg (W_OutData), Ofs (W_OutData) + 7);
  150.           W_InPtr ^ := W_Picture;           { TRANSFER PICTURE DATA }
  151.           W_OutData [4008] := EndOfFile;    { MARK END OF FILE }
  152.           Assign (W_OutFile, OName);
  153.           Rewrite (W_OutFile);
  154.           Write (W_OutFile, W_OutData);
  155.           Close (W_InFile);
  156.           Close (W_OutFile);
  157.         END;
  158.       Writeln ('File ' + OName + ' created');
  159.     END.     { Pic_Bld }
  160.